
# loading functions from ideal_function.R file

source("Scripts\\functions.R")

# creating a vector with packages names

packages <- c("remotes", "tidyverse", "ggthemes", "patchwork",
              "openxlsx", "here", "rlang", "ggrepel", "dataverse", "readr")

# Installing/loading packages

usePackage(packages)

# Installing idealstan package from github

remotes::install_github('saudiwin/idealstan',
                        build_vignette = TRUE,
                        ref = "develop")

library(idealstan)


############################################################################

# Loading UNGA proposals data

Sys.setenv("DATAVERSE_SERVER" = "dataverse.harvard.edu")

unga_proposals <- get_dataframe_by_name("ldocs 2000-2020 (S55-S74).tab",
                                        "10.7910/DVN/MPQUE2") %>%
  filter(session > 63 & session < 74)

# Loading voting data

unga_weighted <- get_dataframe_by_name("drafts rel 2000-2020 (S55-S74).tab",
                                       "10.7910/DVN/MPQUE2") %>%
  filter(session > 63 & session < 74) %>%
  mutate(across(AFG:ZWE, ~recode(.,
                                 `1` = 3,
                                 `3` = 1,
                                 `2` = 2)))


############################################################################

# Tidying data

tidy_weighted <-  
  unga_weighted %>% 
  dplyr::select(ldoc_final, AFG:ZWE) %>%
  gather(country, sponsor, -ldoc_final) %>%
  filter(country %!in% c("YUG", "SUN", "SCG", "CSK", "BYS")) %>%
  left_join(unga_proposals, by = c("ldoc_final" = "undocsymbol")) %>%
  filter(!(country == "SSD" & session < 66)) %>%
  mutate(sponsor = as_factor(sponsor),
         ordered_id = 3) 

# Creating an object required to use idealstan package to estimate
# dynamic ideal points

unga_data <- id_make(tidy_weighted,
                    outcome_disc = 'sponsor',
                    person_id = 'country',
                    item_id = 'ldoc_final',
                    time_id='session',
                    ordered_id = "ordered_id")

# Estimating ideal points
# WARNING: This function will require days (using an 
# Intel Core i7-6700HQ) to estimate ideal points.

unga_random <- estimate_ideal_points(unga_data,
                          model_type = 5,
                          ncores = 4,
                          nchains = 2,
                          niters = 2000,
                          warmup = 4000,
                          time_var = 1,
                          fixtype='prefix',
                          restrict_ind_high = "KNA",
                          restrict_ind_low = "DEU",
                          vary_ideal_pts='random_walk',
                          # restrict_ind_high = "LUX",
                          # restrict_ind_low = "IRN",
                          seed=84520,
                          id_refresh = 100)

# If you don't have time to run the code for days, you can load the data
# using this code

attach("Data\\unga_random.RData")
unga_random <- unga_random

# Extracting ideal point values from the object we just created

points_sponsor <- extract_ideal_points(unga_random, 
                                    return_data = T)[["data"]]


###############################################################################

#######################
# Figure 1 - panel 1
#######################

panel_1 <-
unga_proposals %>%
  count(session) %>%
ggplot(aes(session, n)) +
  geom_line() +
  scale_y_continuous(limits = c(0, 500)) +
  labs(y = "Number of drafts",
       x = "Session") +
  theme_minimal()

#######################
# Figure 1 - panel 2
#######################

panel_2 <- 
unga_proposals %>%
  ggplot(aes(session, n_sponsors, group = session)) +
  geom_boxplot() +
  labs(y = "Number of final sponsors",
       x = "Session") +
  theme_minimal()

######################
# Figure 1 - panel 3
######################

panel_3 <-
unga_proposals %>%
  ggplot(aes(n_sponsors)) +
  geom_histogram() +
  labs(y = "Draft count",
       x = "Number of sponsors per draft") +
  theme_minimal()

################
# Figure 1
#################

panel_1 + panel_2 + panel_3

ggsave("Graphs\\figure_1.tiff", device = "tiff", 
       width = 296, height = 84, units = "mm", dpi = 300, 
       bg = "white")


#############################################################################

# Getting Bailey's ideal points

bailey_ideal_points <- get_dataframe_by_name("IdealpointestimatesAll_Jun2022.csv",
                                             "10.7910/DVN/LEJUQZ",
                                             readr::read_csv) %>%
  filter(session > 63 & session < 74) %>%
  select(session, IdealPointAll, iso3c)


# Merging Bailey's ideal points with our data
points_sponsor <- points_sponsor %>%
  left_join(bailey_ideal_points,
            by = c("person_id" = "iso3c", 
                   "time_id" = "session"))

###############
# Figure 2
###############

points_sponsor %>%
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  ggplot(aes(median_pt, IdealPointAll)) +
  geom_jitter(alpha = 0.5) +
  geom_smooth(method = "lm") +
  labs(x = "Sponsorship ideal points",
       y = "Bailey et al. ideal points",
       subtitle = paste("Pearson's correlation =", 
                        cor(points_sponsor$median_pt*-1, 
                            points_sponsor$IdealPointAll,
                            method = "pearson",
                            use = "complete.obs") %>% round(2),
                        "Spearman's correlation =",
                        cor(points_sponsor$median_pt*-1, 
                            points_sponsor$IdealPointAll,
                            method = "spearman",
                            use = "complete.obs") %>% round(2))) +
  theme_minimal()

ggsave("Graphs\\figure_2.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")

###############################################################################

##############
# Figure 3
##############

points_sponsor %>% 
  select(median_pt, IdealPointAll) %>%
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
   pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "value") %>%
  mutate(model = recode(model, "IdealPointAll" = "Bailey et al. ideal points",
                        "median_pt" = "Sponsorship ideal points")) %>%
  ggplot(aes(value)) +
  geom_histogram(bins = 100) +
  facet_wrap(vars(model), nrow = 2, scales = "free_y") +
  theme_minimal()

ggsave("Graphs\\figure_3.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")


###############################################################################

# Getting countries with most divergent values
most_divergent <- 
points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  group_by(person_id) %>%
  summarise(mean_sponsor = mean(median_pt),
            mean_rollcall = mean(IdealPointAll)) %>%
  mutate(diff = abs(mean_rollcall - mean_sponsor)) %>%
  slice_max(order_by = diff, n = 12) %>%
  pull(person_id)

##############
# Figure 4
##############

points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "ideal_point") %>%
    filter(person_id %in% most_divergent) %>%
  mutate(person_id = factor(person_id, levels = most_divergent)) %>% 
  ggplot(aes(time_id, ideal_point, color = model )) +
  geom_line() +
  labs(y = "Ideal point",
       x = "Session") +
  facet_wrap(vars(person_id)) +
  theme_minimal() +
  theme(legend.position="bottom")  +
  scale_color_hue(labels = c("Bailey et al.", "Sponsorship"))

ggsave("Graphs\\figure_4.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")

###############################################################################

# creating a vector with the sum of sponsorship weights
weighted_sum <- 
tidy_weighted %>%
  group_by(country, session) %>%
  mutate(weighted_sponsor = as.numeric(sponsor)) %>%
  summarise(sponsor_weights_sum = sum(weighted_sponsor, na.rm = T)) %>%
  rename(person_id = country, time_id = session) 

############
# Figure 5
############

points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1) %>%
  left_join(weighted_sum, by = c("person_id", "time_id")) %>%
  ggplot(aes(median_pt, sponsor_weights_sum)) +
  geom_jitter(alpha = 0.2) +
  theme_minimal() +
  labs(x = "Sponsorship ideal points",
       y = "Sum of sponsorship weights")

ggsave("Graphs\\figure_5.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")

###############################################################################


# getting countries with most extreme values from sponsorship ideal points
extreme_sponsor <- points_sponsor %>%
  mutate(median_pt = rescale_center_median(median_pt) * -1) %>%
  group_by(person_id) %>%
  summarise(mean_sponsor = mean(median_pt, na.rm = T)) %>%
  ungroup() %>%
  # mutate(mean_sponsor = abs(mean_sponsor)) %>%
  select(person_id, mean_sponsor) %>%
  arrange(mean_sponsor) %>%
  slice(c(1:3,(n()-2):n())) %>%
  pull(person_id)

# getting countries with most extrem values from Bailey's ideal points
extreme_bailey <- points_sponsor %>%
  mutate(IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  group_by(person_id) %>%
  summarise(mean_rollcall = mean(IdealPointAll, na.rm = T)) %>%
  ungroup() %>%
  filter(!is.nan(mean_rollcall)) %>%
  # mutate(mean_rollcall = abs(mean_rollcall)) %>%
  select(person_id, mean_rollcall) %>%
  arrange(mean_rollcall) %>%
  slice(c(1:3,(n()-2):n())) %>% 
  pull(person_id)


#############
# Figure 6
#############

points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "ideal_point") %>%
  filter(person_id %in% extreme_bailey |
           person_id %in% extreme_sponsor) %>%
  mutate(person_id = factor(person_id,
                            levels=c(extreme_bailey[1:3], extreme_sponsor[1:3],
                                     extreme_bailey[4:6], extreme_sponsor[4:6]))) %>%
  ggplot(aes(time_id, ideal_point, color = model )) +
  geom_line() +
  labs(y = "Ideal point",
       x = "Session") +
  facet_wrap(vars(person_id)) +
  theme_minimal() +
  theme(legend.position="bottom")  +
  scale_color_hue(labels = c("Bailey et al.", "Sponsorship"))

ggsave("Graphs\\figure_6.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")

###########################################################################

# Getting countries differences from one session to another - sponsor ideal points
diff_sponsor <-
  points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "ideal_point") %>%
  filter(model == "median_pt") %>%
  mutate(points = ideal_point + 1) %>%
  dplyr::group_by(person_id) %>%
  arrange(time_id) %>%
  dplyr::summarise(diff_sponsor = points - lag(points, default = first(points)))

# Getting countries differences from one session to another - Bailey's ideal points

diff_bailey <-
  points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "ideal_point") %>%
  filter(model == "IdealPointAll") %>%
  mutate(points = ideal_point + 1) %>%
  dplyr::group_by(person_id) %>%
  arrange(time_id) %>%
  dplyr::summarise(diff_bailey = points - lag(points, default = first(points)))

# looking if differences are positive or negative
sinal_sponsor <- sign(diff_sponsor$diff_sponsor)
sinal_bailey <- sign(diff_bailey$diff_bailey)

# getting where directions are not the same from sponsor and bailey ideal points
sinal <- sinal_sponsor != sinal_bailey

# keeping differences with opposite directions
diff_sponsor <- diff_sponsor[sinal,]
diff_bailey <- diff_bailey[sinal,]

# getting countries with larger differences
opposites <- diff_sponsor %>%
  ungroup() %>%
  select(-person_id) %>%
  bind_cols( diff_bailey) %>%
  mutate(diff = abs(diff_sponsor - diff_bailey)) %>%
  arrange(desc(diff)) %>%
  slice(1:17) %>%
  pull(person_id) %>%
  unique()


############
# Figure 7
############

points_sponsor %>% 
  mutate(median_pt = rescale_center_median(median_pt) * -1,
         IdealPointAll = rescale_center_median(IdealPointAll)) %>%
  pivot_longer(cols = c(median_pt, IdealPointAll),
               names_to = "model",
               values_to = "ideal_point") %>%
  filter(person_id %in% opposites) %>%
  ggplot(aes(x = time_id, y = ideal_point, color = model)) + 
  geom_line( alpha = 0.8) +
  theme_minimal() + 
  facet_wrap(~person_id) +
  labs(x = "Session", y = "Ideal point") +
  theme(legend.position = "bottom") +
  scale_color_hue(labels = c("Bailey et al.", "Sponsorship"))


ggsave("Graphs\\figure_7.tiff", device = "tiff", 
       width = 139, height = 139, units = "mm", dpi = 300, bg = "white")

  
###############################################################

## Correlation with KOF Political Globalization Index


# Database url
url <- 
"https://ethz.ch/content/dam/ethz/special-interest/dual/kof-dam/documents/Globalization/2021/KOFGI_2021_public.xlsx"

# Loading KOF Political Globalization Index data
kof <- read.xlsx(url)

# Merging data
points_sponsor <- points_sponsor %>%
  mutate(year = case_when(time_id == 64 ~ 2009,
                          time_id == 65 ~ 2010,
                          time_id == 66 ~ 2011,
                          time_id == 67 ~ 2012,
                          time_id == 68 ~ 2013,
                          time_id == 69 ~ 2014,
                          time_id == 70 ~ 2015,
                          time_id == 71 ~ 2016,
                          time_id == 72 ~ 2017,
                          time_id == 73 ~ 2018)) %>%
  left_join(kof, by = c("year" = "year", "person_id" = "code"))

# Correlation - sponsorship ideal points x KOF Political Globalization Index
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGI,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGI,
    method = "spearman", use = "complete.obs")

# Correlation - Bailey's ideal points x KOF Political Globalization Index
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGI,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGI,
    method = "spearman", use = "complete.obs")

# Correlation - sponsorship ideal points x KOF Political Globalization Index de facto
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGIdf,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGIdf,
    method = "spearman", use = "complete.obs")

# Correlation - Bailey's ideal points x KOF Political Globalization Index de facto
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGIdf,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGIdf,
    method = "spearman", use = "complete.obs")

# Correlation - sponsorship ideal points x KOF Political Globalization Index de jure
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGIdj,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$median_pt * -1, points_sponsor$KOFPoGIdj,
    method = "spearman", use = "complete.obs")

# Correlation - Bailey's ideal points x KOF Political Globalization Index de jure
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGIdj,
    method = "pearson", use = "complete.obs")
cor(points_sponsor$IdealPointAll, points_sponsor$KOFPoGIdj,
    method = "spearman", use = "complete.obs")
